home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / LOCALRPT.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-01-31  |  21.0 KB  |  768 lines
  1. 10  'LOCALRPT  -  03 JUN 94 rev. 31 JAN 97
  2. 20  IF EX$=""THEN EX$="EXIT"
  3. 30  PROG$="localrpt"
  4. 40  COMMON EX$,PROG$
  5. 50  IF POSN THEN 670
  6. 60  ON ERROR GOTO 510
  7. 70  CLS:KEY OFF
  8. 80  COLOR 7,0,1
  9. 90  DIM A$(511,7),F$(26,2)
  10. 100  DIM B$(511)
  11. 110  U1$="#####.#"
  12. 120  U2$="##,###.#"
  13. 130  U3$="####.#"
  14. 140  U4$="####,###.#"
  15. 150  U5$="###.#"
  16. 160  U6$="#####"
  17. 170  U7$="####"
  18. 180  U8$="######"
  19. 190  UL$=STRING$(80,205)
  20. 200  XX$=STRING$(79,32)          'blank
  21. 210  PI=3.14159
  22. 220  GOTO 300
  23. 230  '
  24. 240  '.....sorting notice
  25. 250  W$=" S O R T I N G ..........Please Wait......"
  26. 260  CLS:LOCATE 12,(80-LEN(W$))/2:COLOR 15,1
  27. 270  PRINT W$
  28. 280  RETURN
  29. 290  '
  30. 300  '.....start
  31. 310  CLS:POSN=0
  32. 320  PRINT " LOCAL REPEATERS"
  33. 330  PRINT UL$;
  34. 340  GOSUB 7450    'preface
  35. 350  PRINT UL$;
  36. 360  PRINT " Press number in < > to choose standard unit of measure:"
  37. 370  PRINT UL$;
  38. 380  PRINT "   < 1 >  Metric"
  39. 390  PRINT "   < 2 >  U.S.A./Imperial"
  40. 400  PRINT UL$;
  41. 410  PRINT "     or Press < 0 > to EXIT....."
  42. 420  Z$=INKEY$
  43. 430  IF Z$="0"THEN CLS:RUN EX$
  44. 440  IF Z$="1"THEN UM=1:UM$="Km.":GOTO 470
  45. 450  IF Z$="2"THEN UM=1.60933:UM$="mi.":GOTO 470
  46. 460  GOTO 420
  47. 470  GOSUB 240   'sorting notice
  48. 480  COLOR 7,0
  49. 490  GOTO 560
  50. 500  '
  51. 510  '.....error trap
  52. 520  PRINT "Error";ERR;"in line";ERL;"...Press any key to start over..."
  53. 530  IF INKEY$=""THEN 530
  54. 540  GOTO 10
  55. 550  '
  56. 560  '.....load data
  57. 570  N=0
  58. 580  OPEN "I",1,"\data\index\rptrdex.fil"
  59. 590  IF EOF(1) THEN 650
  60. 600  N=N+1
  61. 610  FOR Y=1 TO 7
  62. 620  INPUT# 1,A$(N,Y)
  63. 630  NEXT Y
  64. 640  GOTO 590
  65. 650  CLOSE
  66. 660  '
  67. 670  '.....display
  68. 680  CLS
  69. 690  COLOR 15,2
  70. 700  PRINT " LOCAL REPEATERS";
  71. 710  PRINT TAB(57);"by George Murphy VE3ERP ";
  72. 720  COLOR 1,0:PRINT STRING$(80,223);
  73. 730  COLOR 7,0
  74. 740  IF POSN THEN Z=POSN:GOSUB 1140:GOTO 980
  75. 750  '
  76. 760  GOSUB 2300     'text
  77. 770  PRINT UL$;
  78. 780  PRINT " Press number in < > to:"
  79. 790  PRINT UL$;
  80. 800  PRINT "  < 1 >  VIEW/EDIT/SEARCH List of Local Repeaters"
  81. 810  PRINT "  < 2 >  LIST repeaters within a SPECIFIED RANGE of any base station"
  82. 820  PRINT "  < 3 >  LOCATE a repeater on a RADAR SCREEN centred on any location"
  83. 830  PRINT "  < 4 >  Convert Degrees/Minutes/Seconds to Decimal Degrees"
  84. 840  Z$=INKEY$
  85. 850  IF Z$="1"THEN 3300                  'data base program
  86. 860  IF Z$="2"THEN FAR$="k":GOTO 6450    'repeater range
  87. 870  IF Z$="3"THEN FAR$="k":GOTO 910     'far$=k=kilometres
  88. 880  IF Z$="4"THEN CLS:CHAIN"equiv"
  89. 890  GOTO 840
  90. 900  '
  91. 910  '.....inputs
  92. 920  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  93. 930  LA(1)=0:LA(2)=0:LO(1)=0:LO(2)=0
  94. 940  STN=0
  95. 950  STN$(1)=" HOME "
  96. 960  STN$(2)=" REPEATER "
  97. 970  '
  98. 980  STN=STN+1
  99. 990  IF POSN THEN ZZ=POSN ELSE ZZ=1
  100. 1000  IF POSN<>1 THEN 1030
  101. 1010  GOSUB 1110
  102. 1020  '
  103. 1030     FOR Z=ZZ TO 2   '********** start input loop **********
  104. 1040  DOT$=STRING$(39-LEN(P$(Z)),".")
  105. 1050  IF POSN=Z THEN GOSUB 1110:GOTO 1180
  106. 1060  IF(P$(Z)<>"" AND LA(Z)*LO(Z))THEN 1180
  107. 1070  PRINT " Press any key to select";STN$(STN);"station.................."
  108. 1080  IF INKEY$=""THEN 1080
  109. 1090  POSN=Z:GOTO 3300                              'data base program
  110. 1100  '
  111. 1110  '.....format latitude & longitude
  112. 1120  IF SGN(LA(Z))=-1 THEN NS$(Z)="<UNK! {00F8}>S"ELSE NS$(Z)="<UNK! {00F8}>N"
  113. 1130  IF SGN(LO(Z))=-1 THEN EW$(Z)="<UNK! {00F8}>W"ELSE EW$(Z)="<UNK! {00F8}>E"
  114. 1140  RLA(Z)=LA(Z)*PI/180      'latitude in radians
  115. 1150  RLO(Z)=LO(Z)*PI/180      'longitude in radians
  116. 1160  RETURN
  117. 1170  '
  118. 1180     NEXT Z          '********** end input loop **********
  119. 1190  '
  120. 1200  ROUTE=SGN(LA(1)+LA(2))                   'determine north or south route
  121. 1210  IF LA(1)<0 AND LA(2)<0 THEN ROUTE=1      'A & B both in southern hemisphere
  122. 1220  '
  123. 1230  '.....display initial data
  124. 1240  VIEW PRINT 3 TO 23:CLS:VIEW PRINT        'erase screen
  125. 1250  LOCATE 3
  126. 1260  Z=1:GOSUB 1110
  127. 1270  HOME$=P$(1)
  128. 1280  PRINT TAB(2);"HOME QTH:";
  129. 1290  DOT$=STRING$(47-LEN(P$(1)),".")
  130. 1300  PRINT TAB(12);P$(1);" ";DOT$;
  131. 1310  PRINT TAB(61);USING U1$;ABS(LA(1));
  132. 1320  PRINT NS$(1);USING U1$;ABS(LO(1));
  133. 1330  PRINT EW$(1);
  134. 1340  Z=2:GOSUB 1110
  135. 1350  PRINT TAB(2);"AWAY QTH:";
  136. 1360  DOT$=STRING$(47-LEN(P$(2)),".")
  137. 1370  PRINT TAB(12);P$(2);" ";DOT$;
  138. 1380  PRINT TAB(61);USING U1$;ABS(LA(2));
  139. 1390  PRINT NS$(2);USING U1$;ABS(LO(2));
  140. 1400  PRINT EW$(2)
  141. 1410  GOSUB 1510                                'to make B > A
  142. 1420   MERID=0                                  'default value
  143. 1430   IF LO(1)=LO(2)THEN MERID=1:GOTO 1480     'A & B on same meridian
  144. 1440  IF ABS(LO(1))+ABS(LO(2))<>180 THEN 1480
  145. 1450   LA(2)=180-LA(2):MERID=1                  'A & B on opposite meridians
  146. 1460   IF LA(2)>180 THEN LA(2)=LA(2)-90
  147. 1470   RLA(2)=LA(2)*PI/180                      'angle in radians
  148. 1480  GOSUB 2630                                'calculation sub-routine
  149. 1490  GOTO 1610                                 'screen print
  150. 1500  '
  151. 1510  '.....point B must be place of greater latitude
  152. 1520  ALA=RLA(1):BLA=RLA(2)
  153. 1530  IF(ALA=BLA)AND(RLO(1)>RLO(2))THEN 1560              'both on equator
  154. 1540  IF (ALA<0)AND(BLA<0)THEN ALA=ABS(ALA):BLA=ABS(BLA)  'both south of equator
  155. 1550  IF BLA>ALA THEN 1590
  156. 1560  SWAP RLA(1),RLA(2)
  157. 1570  SWAP RLO(1),RLO(2)
  158. 1580  SWAP P$(1),P$(2)
  159. 1590  RETURN
  160. 1600  '
  161. 1610  '.....display balance of data
  162. 1620  LONDIFF=ABS(LO(1)-LO(2))                  'difference in longitude
  163. 1630  IF LONDIFF >180 THEN LONDIFF=360-LONDIFF
  164. 1640  ZONE=LONDIFF/15                           'no. of 1 hr.time zones
  165. 1650  MIN=INT((ZONE)*60)                        'minutes
  166. 1660  SEC=(ZONE*60-MIN)*60                      'seconds
  167. 1670  T=12                                      'tab
  168. 1680  KM=ZD*4*10^4/360
  169. 1690  MI=KM/1.60935
  170. 1700   PRINT TAB(T);"Great Circle distance";STRING$(27,".");USING U8$;KM;
  171. 1710   PRINT " km=";USING U6$;MI;:PRINT " mi."
  172. 1720   PRINT TAB(T);"Solar Time difference";STRING$(27,".");USING U8$;MIN;
  173. 1730    PRINT " min.";USING U7$;SEC;:PRINT " sec.";
  174. 1740    D1$=STRING$(35-LEN(P$(1)),".")
  175. 1750   PRINT TAB(T);"Bearing from ";P$(1);D1$;TAB(63);USING U5$;XD;:PRINT "<UNK! {00F8}>"
  176. 1760   IF P$(1)=HOME$ THEN BRG=XD
  177. 1770    D2$=STRING$(35-LEN(P$(2)),".")
  178. 1780   PRINT TAB(T);"Bearing from ";P$(2);D2$;TAB(63);USING U5$;YD;:PRINT "<UNK! {00F8}>"
  179. 1790   IF P$(2)=HOME$ THEN BRG=YD
  180. 1800  PRINT UL$;
  181. 1810  '
  182. 1820  PRINT " BEARINGS ARE"
  183. 1830  PRINT " FROM TRUE NORTH"
  184. 1840  PRINT " THENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHEN
  185. 1850  PRINT " ";
  186. 1860  COLOR 15,1
  187. 1870  PRINT "<*>";
  188. 1880  COLOR 7,0
  189. 1890  PRINT " = ";RPT$
  190. 1900  PRINT " Output: ";XMT$
  191. 1910  PRINT " Offset: ";SET$
  192. 1920  PRINT " Input:  ";RCV$
  193. 1930  PRINT " THENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHEN
  194. 1940  R=7      'radial
  195. 1950  H=R^2/2  '1/2 square of hypotenuse
  196. 1960  X=41     'x-axis
  197. 1970  Y=17     'y-axis
  198. 1980  XY=2.34375  'xy ratio
  199. 1990  FOR Z=Y-R TO Y+R
  200. 2000   LOCATE Z,X-18
  201. 2010   PRINT STRING$(37,"CSRLIN");
  202. 2020  IF Z<Y+R THEN PRINT ""
  203. 2030  NEXT Z
  204. 2040  COLOR 15,3
  205. 2050  LOCATE Y-R,X-2:PRINT "  N  "
  206. 2060  LOCATE Y-SQR(H),X-(SQR(H)*XY)-1.5:PRINT " NW "
  207. 2070  LOCATE Y-SQR(H),X+(SQR(H)*XY)-1.5:PRINT " NE "
  208. 2080  LOCATE Y,X-(R*XY)-2:PRINT "  W  "
  209. 2090  COLOR 15,1
  210. 2100  LOCATE Y,X-3:PRINT " HO*ME "
  211. 2110  COLOR 15,3
  212. 2120  LOCATE Y,X+(R*XY)-2:PRINT "  E  "
  213. 2130  LOCATE Y+SQR(H),X-(SQR(H)*XY)-1.5:PRINT " SW "
  214. 2140  LOCATE Y+SQR(H),X+(SQR(H)*XY)-1.5:PRINT " SE "
  215. 2150  LOCATE Y+R,X-2:PRINT "  S  ";
  216. 2160  '....BRG = bearing from home station
  217. 2170  BRG=BRG-90              'bearing in degrees
  218. 2180  HDG=BRG*3.14159/180    'bearing in radians
  219. 2190  YY=SIN(HDG)*R
  220. 2200  XX=COS(HDG)*R*XY
  221. 2210  COLOR 15,1
  222. 2220  LOCATE Y+YY,X+XX-1
  223. 2230  PRINT "<*>";
  224. 2240  LOCATE Y+YY/2,INT(X+XX/2-3)
  225. 2250  COLOR 15,0
  226. 2260  PRINT CINT(KM/UM);UM$
  227. 2270  COLOR 7,0:GOSUB 7550
  228. 2280  GOTO 300   'start
  229. 2290  '
  230. 2300  '.....text
  231. 2310  TB=7
  232. 2320  PRINT TAB(TB);
  233. 2330  PRINT "  When you first run this program, add your own station to the"
  234. 2340  PRINT TAB(TB);
  235. 2350  PRINT "data base, listing your output as 0 Mhz and your offset as +0 Khz."
  236. 2360  PRINT TAB(TB);
  237. 2370  PRINT "Enter your latitude and longitude, which you can determine from a"
  238. 2380  PRINT TAB(TB);
  239. 2390  PRINT "good road map or atlas. Enter these in decimal degrees, to the"
  240. 2400  PRINT TAB(TB);
  241. 2410  PRINT "nearest 0.1 degree."
  242. 2420  PRINT TAB(TB);
  243. 2430  PRINT "  You can then add your local repeaters, and delete any that are"
  244. 2440  PRINT TAB(TB);
  245. 2450  PRINT "in the data base but are of no interest to you. I left a sample"
  246. 2460  PRINT TAB(TB);
  247. 2470  PRINT "list of repeaters and my own station (VE3ERP) as Home Station in"
  248. 2480  PRINT TAB(TB);
  249. 2490  PRINT "the data base so first-time users of this program can fool around"
  250. 2500  PRINT TAB(TB);
  251. 2510  PRINT "with it before entering their own data."
  252. 2520  PRINT TAB(TB);
  253. 2530  PRINT "  The data base can be edited at any time to add, delete or change"
  254. 2540  PRINT TAB(TB);
  255. 2550  PRINT "any listings."
  256. 2560  PRINT
  257. 2570  PRINT TAB(TB);
  258. 2580  PRINT "  ......73 de VE3ERP......"
  259. 2590  RETURN
  260. 2600  '
  261. 2610  '**********SUB-ROUTINES**********
  262. 2620  '
  263. 2630  '.....calculate bearings and distance
  264. 2640  REM RLA(n) & RLO(n) are LAT & LONG inputs in radians
  265. 2650  LB=RLA(2)                               'latitude of point B in radians
  266. 2660  LA=RLA(1)                               'latitude of point A in radians
  267. 2670  IF LA=0 AND LB=0 THEN 2860              'both points on equator
  268. 2680  C=RLO(1)-RLO(2)                         'difference in longitude
  269. 2690  IF C=0 THEN 2730                        'both points on same meridian
  270. 2700  IF ABS(C)=PI THEN 2790                  'points on opposite meridian
  271. 2710  GOTO 2950
  272. 2720  '
  273. 2730  '.....A & B both on same meridian
  274. 2740  ZR=LB-LA:ZD=ZR*180/PI
  275. 2750  Y=PI:YD=180
  276. 2760  X=0:XD=0
  277. 2770  RETURN
  278. 2780  '
  279. 2790  '.....A & B on opposite meridians
  280. 2800  ZR=LB-LA:IF ZR>PI THEN ZR=2*PI-ZR
  281. 2810  IF ZR<PI THEN Y=0:YD=0:X=0:XD=0
  282. 2820  IF ZR>PI THEN Y=PI:YD=180:X=PI:XD=180
  283. 2830  ZD=ZR*180/PI
  284. 2840  RETURN
  285. 2850  '
  286. 2860  '.....A & B both on equator
  287. 2870  EQUAT=1                                 'flag
  288. 2880  Y=PI/2:YD=Y*180/PI
  289. 2890  X=1.5*PI:XD=X*180/PI
  290. 2900  L=ABS(RLO(1)-RLO(2))
  291. 2910  IF L>PI THEN L=2*PI-L
  292. 2920  ZR=L:ZD=ZR*180/PI
  293. 2930  GOTO 3110
  294. 2940  '
  295. 2950  '.....formula elements
  296. 2960  F0=1/TAN(C/2)                           'cotangent C/2
  297. 2970  F1=F0*SIN((LB-LA)/2)/COS((LB+LA)/2)
  298. 2980  IF LB+LA=0 THEN F2=F0*COS((LB-LA)/2)/SIN(9.8E-08):GOTO 3000
  299. 2990  F2=F0*COS((LB-LA)/2)/SIN((LB+LA)/2)
  300. 3000  F3=ATN(F1)
  301. 3010  F4=ATN(F2)
  302. 3020  '
  303. 3030  '.....bearings
  304. 3040  Y=F4+F3                                 'bearing at point B
  305. 3050  IF LA<0 AND LB<0 THEN Y=Y+PI:GOTO 3070  'A & B both in southern hemisphere
  306. 3060  IF ABS(LA)>ABS(LB)THEN Y=Y+PI
  307. 3070  IF Y<0 THEN Y=Y+2*PI
  308. 3080  IF Y>=(2*PI)THEN Y=Y-2*PI
  309. 3090  YD=Y*180/PI                             'bearing in degrees at point B
  310. 3100  '
  311. 3110  X=F4-F3                                 'bearing at point A
  312. 3120  IF LA<0 AND LB<0 THEN X=X+PI:GOTO 3140  'A & B both in southern hemisphere
  313. 3130  IF ABS(LA)>ABS(LB)THEN X=X+PI
  314. 3140  IF X<0 THEN X=X+2*PI
  315. 3150  IF X>=(2*PI)THEN X=X-2*PI
  316. 3160  XR=2*PI-X                               'reciprocal
  317. 3170  IF XR<0 THEN XR=XR+2*PI
  318. 3180  IF XR>=(2*PI)THEN XR=XR-2*PI
  319. 3190  XD=XR*180/PI                            'bearing in degrees at point A
  320. 3200  '
  321. 3210  '.....distance
  322. 3220  IF RLO(1)=RLO(2)THEN ZR=ABS(LB-LA):GOTO 3260
  323. 3230  IF LA=LB THEN LB=LB+9.8E-08:GOTO 2680  'avoids trig function of angle 0
  324. 3240  F5=TAN((LB-LA)/2)*SIN(F4)/SIN(F3)       'F5=tan ZR/2 (ZR=distance angle)
  325. 3250  ZR=ABS(2*ATN(F5))                       'distance angle in radians
  326. 3260  ZD=ZR*180/PI                            'distance angle in degrees
  327. 3270  '
  328. 3280  RETURN
  329. 3290  '
  330. 3300  '.....data base program
  331. 3310  CLS
  332. 3320  IF FAR$<>""THEN 4950
  333. 3330  COLOR 15,2
  334. 3340  PRINT " LOCAL REPEATERS "
  335. 3350  COLOR 1,0:PRINT STRING$(80,223);
  336. 3360  COLOR 7,0
  337. 3370  PRINT " Press number in < > to:"
  338. 3380  PRINT UL$;
  339. 3390  PRINT "  < 1 >  ADD a listing"
  340. 3400  PRINT "  < 2 >  FIND/EDIT a listing"
  341. 3410  PRINT "  < 3 >  DISPLAY listings"
  342. 3420  Z$=INKEY$
  343. 3430  IF Z$="1"THEN CLS:GOTO 4030
  344. 3440  IF Z$="2"THEN CLS:GOTO 4950
  345. 3450  IF Z$="3"THEN GOSUB 4150:GOTO 4450
  346. 3460  GOTO 3420
  347. 3470  '
  348. 3480  '.....save data
  349. 3490  OPEN "O",1,"\data\index\rptrdex.fil"
  350. 3500  FOR Z=1 TO N
  351. 3510  WRITE# 1,A$(Z,1),A$(Z,2),A$(Z,3),A$(Z,4),A$(Z,5),A$(Z,6),A$(Z,7)
  352. 3520  NEXT Z
  353. 3530  CLOSE
  354. 3540  GOTO 300   'start
  355. 3550  '
  356. 3560  '.....change text to capital letters
  357. 3570  FOR U=1 TO LEN(I$)
  358. 3580  V=ASC(MID$(I$,U,1))
  359. 3590  IF V>96 AND V<123 THEN MID$(I$,U,1)=CHR$(V-32)
  360. 3600  NEXT U
  361. 3610  RETURN
  362. 3620  '
  363. 3630  '.....inputs
  364. 3640  INPUT " ENTER: Call sign......................";I$:GOSUB 3560
  365. 3650  GOSUB 3990:RETURN
  366. 3660  '
  367. 3670  LINE INPUT " ENTER: Location (town or area)........?";I$:GOSUB 3560
  368. 3680  IF LEN(I$)<=28 THEN 3740
  369. 3690  CL=CSRLIN-1:BEEP:COLOR 15,4
  370. 3700  PRINT " TOO MANY CHARACTERS - PLEASE ABBREVIATE!....press any key...."
  371. 3710  COLOR 7,0
  372. 3720  IF INKEY$=""THEN 3720
  373. 3730  VIEW PRINT CL TO 24:CLS:VIEW PRINT:LOCATE CL:GOTO 3670
  374. 3740  GOSUB 3990:RETURN
  375. 3750  '
  376. 3760  INPUT " ENTER: Repeater OUTPUT frequency......";I$
  377. 3770  IF LEN(I$)<7 THEN I$=I$+"0":GOTO 3770
  378. 3780  GOSUB 3990:RETURN
  379. 3790  '
  380. 3800  INPUT " ENTER: Repeater input ( + or - )......";I$
  381. 3810  I$=I$+"600"
  382. 3820  IF LEFT$(I$,1)="+"OR LEFT$(I$,1)="-"THEN 3840
  383. 3830  LOCATE CSRLIN-1:PRINT STRING$(80,32);:LOCATE CSRLIN-1:GOTO 3800
  384. 3840  GOSUB 3990:RETURN
  385. 3850  '
  386. 3860  Z=N      'calculate input frequency
  387. 3870    I=VAL(A$(Z,4))/10^3+VAL(A$(Z,3))         'output frequency
  388. 3880    Z$=STR$(I)
  389. 3890    I$=RIGHT$(Z$,LEN(Z$)-1)                  'offset
  390. 3900    IF LEN(I$)<>7 THEN I$=I$+"0":GOTO 3900
  391. 3910    RETURN                                   'input frequency
  392. 3920  '
  393. 3930  INPUT " ENTER: Latitude (minus if south)......";I$
  394. 3940  GOSUB 3990:RETURN
  395. 3950  '
  396. 3960  INPUT " ENTER: Longitude (minus if west)......";I$
  397. 3970  GOSUB 3990:RETURN
  398. 3980  '
  399. 3990  LOCATE CSRLIN-1:PRINT STRING$(7,32)
  400. 4000  LOCATE CSRLIN-1,40:PRINT "  ";I$
  401. 4010  RETURN
  402. 4020  '
  403. 4030  '.....new listing
  404. 4040  N=N+1
  405. 4050  PRINT " NEW LISTING"
  406. 4060  PRINT UL$;
  407. 4070   FOR X=1 TO 7
  408. 4080   ON X GOSUB 3640,3670,3760,3800,3860,3930,3960
  409. 4090   A$(N,X)=I$
  410. 4100   NEXT X
  411. 4110  CLS
  412. 4120  Z=N
  413. 4130  GOTO 6020
  414. 4140  '
  415. 4150  '.....sort
  416. 4160  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  417. 4170  PRINT " Press number in < > to SORT LISTINGS by:"
  418. 4180  PRINT UL$;
  419. 4190  PRINT "  < 1 >  Call Sign"
  420. 4200  PRINT "  < 2 >  Location"
  421. 4210  PRINT "  < 3 >  Output Frequency"
  422. 4220  Y$=INKEY$
  423. 4230  IF Y$="1"OR Y$="2"OR Y$="3"THEN 4250
  424. 4240  GOTO 4220
  425. 4250  IF Y$="1"THEN J=1:K=2:TOP$=" Call Sign"
  426. 4260  IF Y$="2"THEN J=2:K=1:TOP$=" Location"
  427. 4270  IF Y$="3"THEN J=3:K=1:TOP$=" Output Frequency"
  428. 4280  '
  429. 4290  VIEW PRINT 3 TO 24:CLS:VIEW PRINT
  430. 4300  GOSUB 240:COLOR 7,0   'sorting notice
  431. 4310  SN=N:SM=SN
  432. 4320  SM=INT(SM/2):IF SM=0 THEN 4430
  433. 4330  SK=SN-SM:SJ=1
  434. 4340  SI=SJ
  435. 4350  SL=SI+SM
  436. 4360  IF A$(SI,J)+A$(SI,K)<=A$(SL,J)+A$(SL,K) THEN 4410
  437. 4370  FOR X=1 TO 7
  438. 4380  SWAP A$(SI,X),A$(SL,X)
  439. 4390  NEXT X
  440. 4400  SI=SI-SM:IF SI>0 THEN 4350
  441. 4410  SJ=SJ+1:IF SJ>SK THEN 4320
  442. 4420  GOTO 4340
  443. 4430  RETURN
  444. 4440  '
  445. 4450  '.....screen display
  446. 4460  VIEW PRINT 3 TO 24:CLS:VIEW PRINT
  447. 4470  LOCATE 1,18:PRINT N;"listings in order of";TOP$
  448. 4480  LOCATE 3
  449. 4490  PRINT " Callsign";TAB(21);"Location";
  450. 4500  PRINT TAB(41);"Output  Offset   Input    Lat.    Long."
  451. 4510  PRINT UL$;
  452. 4520  LIN=4            'line no.
  453. 4530  '
  454. 4540  FOR Z=1 TO N                     'start loop
  455. 4550   LIN=LIN+1
  456. 4560   IF LIN<25 THEN 4620
  457. 4570  '
  458. 4580   LOCALE=1:GOSUB 7550
  459. 4590   LIN=1
  460. 4600   COLOR 7,0:CLS
  461. 4610  '
  462. 4620  GOSUB 4820                                    'determine NEWS suffix
  463. 4630  PRINT TAB(2);A$(Z,1);                         'call sign
  464. 4640  PRINT TAB(11);A$(Z,2);                        'location
  465. 4650  PRINT STRING$(29-LEN(A$(Z,2)),".");
  466. 4660  PRINT TAB(41);USING "###.###";VAL(A$(Z,3));   'output
  467. 4670  PRINT TAB(50);USING "+###";VAL(A$(Z,4));      'offset
  468. 4680    I=VAL(A$(Z,3))+VAL(A$(Z,4))*10^-3           'input
  469. 4690    Z$=STR$(I)
  470. 4700    I$=RIGHT$(Z$,LEN(Z$)-1)                     'offset
  471. 4710    IF LEN(I$)<7 THEN I$=I$+"0":GOTO 4710
  472. 4720    A$(Z,5)=I$
  473. 4730  PRINT TAB(56);USING "###.###";VAL(A$(Z,5));   'input
  474. 4740  IF Z1*Z2=0 THEN 4770
  475. 4750  PRINT TAB(65);USING U5$;ABS(Z1);:PRINT Z1$;   'latitude
  476. 4760  PRINT TAB(73);USING U5$;ABS(Z2);:PRINT Z2$;   'longitude
  477. 4770  IF LIN<24 THEN PRINT ""
  478. 4780  NEXT Z
  479. 4790  GOSUB 7550     'screen dump
  480. 4800  GOTO 3480      'save & return to menu
  481. 4810  '
  482. 4820  '.....determine NSEW suffix
  483. 4830  E$=CHR$(248)
  484. 4840  Z1=VAL(A$(Z,6)):IF Z1<0 THEN Z1$=E$+"S"ELSE Z1$=E$+"N"
  485. 4850  Z2=VAL(A$(Z,7)):IF Z2<0 THEN Z2$=E$+"W"ELSE Z2$=E$+"E"
  486. 4860  RETURN
  487. 4870  '
  488. 4880  '.....menu return
  489. 4890  CLS
  490. 4900  PRINT:PRINT " Nothing starting with ";I$;" on file...."
  491. 4910  PRINT:PRINT " Press SPACE BAR to return to Menu
  492. 4920  Z$=INKEY$:IF Z$=" "THEN 300
  493. 4930  GOTO 4920
  494. 4940  '
  495. 4950  '.....find listing
  496. 4960  LOCATE 1
  497. 4970  PRINT " Press number in < > to find listing by:"
  498. 4980  PRINT UL$;
  499. 4990  PRINT "  < 1 >  CALL SIGN"
  500. 5000  PRINT "  < 2 >  LOCATION"
  501. 5010  PRINT "  < 3 >  OUTPUT FREQUENCY"
  502. 5020  K$=INKEY$
  503. 5030  IF K$="1"THEN CLS:F1$="CALL SIGN":GOTO 5080
  504. 5040  IF K$="2"THEN CLS:F1$="LOCATION":GOTO 5080
  505. 5050  IF K$="3"THEN CLS:F1$="OUTPUT FREQUENCY":GOTO 5080
  506. 5060  GOTO 5020
  507. 5070  '
  508. 5080  '.....find listing
  509. 5090  LOCATE 1
  510. 5100  PRINT " ENTER: First few characters in ";F1$;" ";:INPUT I$
  511. 5110  GOSUB 3560         'capitalize
  512. 5120  CLS
  513. 5130  LOCATE 24,35:PRINT " SEARCHING...";
  514. 5140  LOCATE 1
  515. 5150  L=LEN(I$):F=0
  516. 5160  K=VAL(K$)
  517. 5170  FOR Z=1 TO N
  518. 5180     IF LEFT$(A$(Z,K),L)<>I$ THEN 5300
  519. 5190     F=F+1
  520. 5200     F$(F,2)=STR$(Z)
  521. 5210     F$(F,1)=A$(Z,1)
  522. 5220     IF A$(Z,2)<>""THEN F$(F,1)=F$(F,1)+", "+A$(Z,2)
  523. 5230     IF F$(F,1)+F$(F,2)=F$(F-1,1)+F$(F-1,2)THEN F=F-1:GOTO 5300
  524. 5240     IF F<26 THEN 5300
  525. 5250     CLS:BEEP:PRINT" LIST TOO LONG TO FIT THE SCREEN!"
  526. 5260     PRINT
  527. 5270     PRINT" Please enter an extra character or two for a shorter list."
  528. 5280     PRINT
  529. 5290     GOTO 5100
  530. 5300  NEXT Z:IF F=0 THEN 4880
  531. 5310  CLS:IF F=1 THEN Z=VAL(F$(F,2)):GOTO 5520
  532. 5320  '
  533. 5330  PRINT F1$;"S starting with ";
  534. 5340  COLOR 0,7:PRINT " ";I$;" ":COLOR 7,0
  535. 5350  PRINT UL$;
  536. 5360  CF=CINT(F/2)
  537. 5370  FOR Z=1 TO CINT(F/2)
  538. 5380  PRINT "(";CHR$(96+Z);") ";F$(Z,1);TAB(41);
  539. 5390  PRINT "(";CHR$(96+CF+Z);") ";F$(Z+CF,1)
  540. 5400  NEXT Z
  541. 5410  IF F/2<>INT(F/2)THEN LOCATE CSRLIN-1,41:PRINT STRING$(39,32)
  542. 5420  PRINT UL$;
  543. 5430  LIN=CSRLIN
  544. 5440  PRINT " Press letter in ( ) to select listing or <0> to return to menu"
  545. 5450  Z$=INKEY$:IF Z$=""THEN 5450
  546. 5460  IF Z$="0"THEN 3300
  547. 5470  Z=ASC(Z$)-96
  548. 5480  IF Z>=1 AND Z<=F THEN Y=Z:Z=VAL(F$(Y,2)):CLS:GOTO 5510
  549. 5490  GOTO 5450
  550. 5500  '
  551. 5510  '.....display listing
  552. 5520  GOSUB 5750
  553. 5530  PRINT " Press number in ( ) to:"
  554. 5540  PRINT UL$;
  555. 5550  IF POSN=1 THEN POSN$="centre of the radar screen"
  556. 5560  IF POSN=2 THEN POSN$="repeater blip on the radar screen"
  557. 5570  IF POSN=3 THEN POSN$="location of the BASE STATION"
  558. 5580  IF FAR$=""THEN PRINT :GOTO 5610
  559. 5590  PRINT " ( 1 )  SELECT this listing as the ";POSN$
  560. 5600  IF FAR$<>""THEN 5630
  561. 5610  PRINT " ( 2 )  EDIT Listing
  562. 5620  PRINT " ( 3 )  DELETE Listing
  563. 5630  PRINT UL$;
  564. 5640  PRINT " ( 0 )  RETURN to menu
  565. 5650  Z$=INKEY$
  566. 5660  IF FAR$=""THEN 5700
  567. 5670  IF Z$="1"AND(POSN=1 OR POSN=2)THEN CLS:GOTO 5900
  568. 5680  IF Z$="1"AND POSN=3 THEN CLS:GOTO 6510
  569. 5690  IF FAR$<>""THEN 5720
  570. 5700  IF Z$="2"THEN CLS:GOTO 6020
  571. 5710  IF Z$="3"THEN BEEP:PRINT:GOTO 6270
  572. 5720  IF Z$="0"THEN 300
  573. 5730  GOTO 5650
  574. 5740  '
  575. 5750  '.....print listing
  576. 5760  PRINT" Call sign...line 1: ";A$(Z,1)
  577. 5770  PRINT" Location....line 2: ";A$(Z,2)
  578. 5780  PRINT" Output......line 3: ";A$(Z,3)
  579. 5790  PRINT" Offset......line 4: ";A$(Z,4)
  580. 5800  PRINT" Input.......line 5: ";A$(Z,5)
  581. 5810  B=VAL(A$(Z,6)):IF B<0 THEN B$=E$+"S"ELSE B$=E$+"N"
  582. 5820  PRINT" Latitude....line 6: ";
  583. 5830  PRINT USING"###.#";ABS(B);:PRINT B$
  584. 5840  B=VAL(A$(Z,7)):IF B<0 THEN B$=E$+"W"ELSE B$=E$+"E"
  585. 5850  PRINT" Longitude...line 7: ";
  586. 5860  PRINT USING"###.#";ABS(B);:PRINT B$
  587. 5870  PRINT UL$;
  588. 5880  RETURN
  589. 5890  '
  590. 5900  '.....assign variables for Great Circle calculations
  591. 5910  P$(POSN)=A$(Z,1)
  592. 5920  IF A$(Z,2)<>""THEN P$(POSN)=P$(POSN)+", "+A$(Z,2)
  593. 5930  RPT$=A$(Z,1)
  594. 5940  XMT$=A$(Z,3)
  595. 5950  SET$=A$(Z,4)
  596. 5960  RCV$=A$(Z,5)
  597. 5970  LA(POSN)=VAL(A$(Z,6))
  598. 5980  LO(POSN)=VAL(A$(Z,7))
  599. 5990  GOTO 10
  600. 6000  '
  601. 6010  '.....edit menu
  602. 6020  GOSUB 5750:PRINT " Press number in ( ) to:"
  603. 6030  PRINT UL$;
  604. 6040  FOR Y=1 TO 7
  605. 6050  IF Y<>5 THEN 6080
  606. 6060  PRINT " ( Line 5 changes automatically with any change in ";
  607. 6070  PRINT "line 3 and/or line 4 )":GOTO 6080
  608. 6080  PRINT " (";Y;")  Change Line";Y
  609. 6090  NEXT Y
  610. 6100  PRINT UL$;
  611. 6110  PRINT " ( 0 )  ACCEPT as is"
  612. 6120  PRINT
  613. 6130  Z$=INKEY$:Q=VAL(Z$):IF Q<0 OR Q>7 THEN 6220
  614. 6140  IF Z$="1"THEN GOSUB 3640:A$(Z,1)=I$:CLS:GOTO 6010
  615. 6150  IF Z$="2"THEN GOSUB 3670:A$(Z,2)=I$:CLS:GOTO 6010
  616. 6160  IF Z$="3"THEN GOSUB 3760:A$(Z,3)=I$:GOSUB 3870:A$(Z,5)=I$:CLS:GOTO 6010
  617. 6170  IF Z$="4"THEN GOSUB 6230:A$(Z,4)=I$:GOSUB 3870:A$(Z,5)=I$:CLS:GOTO 6010
  618. 6180  IF Z$="5"THEN 6130
  619. 6190  IF Z$="6"THEN GOSUB 3930:A$(Z,6)=I$:CLS:GOTO 6010
  620. 6200  IF Z$="7"THEN GOSUB 3960:A$(Z,7)=I$:CLS:GOTO 6010
  621. 6210  IF Z$="0"THEN CLS:GOSUB 4290:GOTO 3480     'sort & save
  622. 6220  GOTO 6130
  623. 6230  INPUT " ENTER: Repeater input ( +nnn or -nnn )......";I$
  624. 6240  IF LEN(I$)<4 THEN I$=I$+"0":GOTO 6240
  625. 6250  RETURN
  626. 6260  '
  627. 6270  '.....delete listing
  628. 6280  BEEP:COLOR 0,7
  629. 6290  PRINT " Are you SURE you want to delete this file?   (y/n) "
  630. 6300  COLOR 7,0
  631. 6310  Z$=INKEY$
  632. 6320  IF Z$="y"THEN 6350
  633. 6330  IF Z$="n"THEN CLS:GOTO 5510
  634. 6340  GOTO 6310
  635. 6350  CLS:PRINT " LISTING DELETED":FOR X=Z TO N:FOR Y=1 TO 7
  636. 6360  A$(X,Y)=A$(X+1,Y):NEXT Y:NEXT X:N=N-1:GOTO 3480   'save data
  637. 6370  '
  638. 6380  '.....ACS, ASN                  'GOSUB HERE TO GET ASN/ACS
  639. 6390  IF Z=0 THEN RC=PI/2:GOTO 6420   'Z=VALUE FROM PROGRAM
  640. 6400  IF Z=1 THEN RC=0:GOTO 6420
  641. 6410  RC=-ATN(Z/SQR(1-Z^2))+PI/2      'RC=ANGLE IN RADIANS IF Z=COS
  642. 6420  RS=PI/2-RC                      'RS=ANGLE IN RADIANS IF Z=SIN
  643. 6430  RETURN
  644. 6440  '
  645. 6450  '.....repeater range
  646. 6460  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  647. 6470  PRINT " Press any key to select location of BASE STATION"
  648. 6480  POSN=3:IF INKEY$=""THEN 6480
  649. 6490  CLS:GOTO 4950                'select hub station
  650. 6500  '
  651. 6510  '.....Z=file location of hub station
  652. 6520  LAH=VAL(A$(Z,6))*PI/180        'latitude of hub station
  653. 6530  LOH=VAL(A$(Z,7))*PI/180        'longitude of hub station
  654. 6540  '
  655. 6550  PRINT " ENTER: Maximum range (";UM$;") of base station";:INPUT KM
  656. 6560  KM=KM*UM
  657. 6570  '
  658. 6580  '.....compile, sort & print
  659. 6590  GOSUB 240    'sorting notice
  660. 6600  COLOR 7,0:LOCATE 1
  661. 6610  J=0       'reset counter
  662. 6620     FOR Y=1 TO N
  663. 6630  LAR=VAL(A$(Y,6))*PI/180        'latitude of repeater
  664. 6640  LOR=VAL(A$(Y,7))*PI/180        'longitude of repeater
  665. 6650  IF(LAH=LAR)AND(LOH=LOR)THEN DIS=0:GOTO 6710
  666. 6660  '
  667. 6670  D1=SIN(LAH)*SIN(LAR)+COS(LAH)*COS(LAR)*COS(LOR-LOH) 'D1=cos d2
  668. 6680  '
  669. 6690  D2=ATN(D1/SQR(-D1*D1+1))+PI/2  'distance angle in radians
  670. 6700  DIS=CINT(20000-D2*10^4/PI*2)   'distance in kilometers
  671. 6710  IF DIS>KM THEN 7120            'skip - out of range
  672. 6720  '.....bearing
  673. 6730  IF(LAH=LAR)AND(LOH=LOR)THEN CD=-1:GOTO 6840
  674. 6740  IF(LOH=LOR)AND(LAH<LAR)THEN CD=0:GOTO 6810
  675. 6750  IF(LOH=LOR)AND(LAH>LAR)THEN CD=180:GOTO 6810
  676. 6760  C1=(SIN(LAR)-SIN(LAH)*D1)/(COS(LAH)*SIN(D2))   'bearing formula
  677. 6770  CR=ATN(C1/SQR(-C1*C1+1))+PI/2  'bearing in radians
  678. 6780  CD=CINT(CR*180/PI)
  679. 6790  IF LOH>LOR THEN CD=180+CD
  680. 6800  IF LOH<LOR THEN CD=180-CD
  681. 6810  B1$=STR$(CD)
  682. 6820  IF LEN(B1$)<>4 THEN B1$=" "+B1$:GOTO 6820
  683. 6830  B$=B1$+"<UNK! {00F8}>"
  684. 6840  IF CD=-1 THEN B$="  -  "
  685. 6850                      B2$="  N "
  686. 6860    IF CD> 11.25 THEN B2$=" NNE"
  687. 6870    IF CD> 33.75 THEN B2$="  NE"
  688. 6880    IF CD> 56.25 THEN B2$=" ENE"
  689. 6890    IF CD> 78.75 THEN B2$="  E "
  690. 6900    IF CD>101.25 THEN B2$=" ESE"
  691. 6910    IF CD>123.75 THEN B2$="  SE"
  692. 6920    IF CD>146.25 THEN B2$=" SSE"
  693. 6930    IF CD>168.75 THEN B2$="  S "
  694. 6940    IF CD>191.25 THEN B2$=" SSW"
  695. 6950    IF CD>213.75 THEN B2$="  SW"
  696. 6960    IF CD>236.25 THEN B2$=" WSW"
  697. 6970    IF CD>258.75 THEN B2$="  W "
  698. 6980    IF CD>281.25 THEN B2$=" WNW"
  699. 6990    IF CD>303.75 THEN B2$="  NW"
  700. 7000    IF CD>326.25 THEN B2$=" NNW"
  701. 7010    IF CD>348.75 THEN B2$="  N "
  702. 7020    IF CD=-1     THEN B2$="  - "
  703. 7030  B$=B$+B2$
  704. 7040  B3$=STR$(DIS)
  705. 7050  IF LEN(B3$)<5 THEN B3$=" "+B3$:GOTO 7050
  706. 7060  B$=B$+B3$
  707. 7070  B4$=A$(Y,1)
  708. 7080  IF LEN(B4$)<6 THEN B4$=B4$+" ":GOTO 7080
  709. 7090  B$=B$+"  "+B4$+"  "+(A$(Y,3))+"  "+A$(Y,4)+"  "+A$(Y,5)
  710. 7100  B$=B$+"  "+A$(Y,2)
  711. 7110  J=J+1:B$(J)=B$:B$=""
  712. 7120     NEXT Y
  713. 7130  '
  714. 7140  '******START SORT******
  715. 7150  SN=J
  716. 7160  SM=SN
  717. 7170  SM=INT(SM/2):IF SM=0 THEN CLS:GOTO 7270
  718. 7180  SK=SN-SM:SJ=1
  719. 7190  SI=SJ
  720. 7200  SL=SI+SM
  721. 7210  IF LEFT$(B$(SI),4)<=LEFT$(B$(SL),4)THEN 7230 ELSE SWAP B$(SI),B$(SL)
  722. 7220  SI=SI-SM:IF SI>0 THEN 7200
  723. 7230  SJ=SJ+1:IF SJ>SK THEN 7170
  724. 7240  GOTO 7190
  725. 7250  '******SORT COMPLETED******
  726. 7260  '
  727. 7270  '.....display
  728. 7280  PRINT TAB(13);"Repeaters within";USING U3$;KM/UM;
  729. 7290  PRINT " ";UM$;" of ";A$(Z,2)
  730. 7300  PRINT TAB(13);"(in clockwise order from True North)"
  731. 7310  PRINT UL$;
  732. 7320  PRINT " Bearing";TAB(13);"Km";TAB(18);"Call";TAB(25);"Output";
  733. 7330  PRINT TAB(33);"Offset";TAB(41);"Input";TAB(49);"Location"
  734. 7340  PRINT UL$;
  735. 7350  LN=5
  736. 7360  FOR Z=1 TO J
  737. 7370   LN=LN+1
  738. 7380   PRINT B$(Z);
  739. 7390  IF LN <24 THEN PRINT "":GOTO 7410
  740. 7400  GOSUB 7550:LN=0:CLS:GOTO 7410
  741. 7410  NEXT Z
  742. 7420  PRINT "":GOSUB 7550
  743. 7430  GOTO 300   'start
  744. 7440  '
  745. 7450  '.....preface
  746. 7460  TX=7
  747. 7470  PRINT TAB(TX);
  748. 7480  PRINT "While this program is primarily a data base (which you can edit)"
  749. 7490  PRINT TAB(TX);
  750. 7500  PRINT "of your local repeaters, it also computes interesting information"
  751. 7510  PRINT TAB(TX);
  752. 7520  PRINT "and screen displays concerning them."
  753. 7530  RETURN
  754. 7540  '
  755. 7550  'HARDCOPY
  756. 7560  GOSUB 7670:LOCATE 25,2:COLOR 14,6
  757. 7570  PRINT " Press 1 to print screen, 2 to print screen & ";
  758. 7580  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  759. 7590  Z$=INKEY$:IF Z$="3"THEN GOSUB 7670:RETURN
  760. 7600  IF Z$="1"OR Z$="2"THEN GOSUB 7670:GOTO 7620
  761. 7610  GOTO 7590
  762. 7620  FOR QX=1 TO 24:FOR QY=1 TO 80
  763. 7630  LPRINT CHR$(SCREEN(QX,QY));
  764. 7640  NEXT QY:NEXT QX
  765. 7650  IF Z$="2"THEN LPRINT CHR$(12)
  766. 7660  GOTO 7560
  767. 7670  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  768.